home *** CD-ROM | disk | FTP | other *** search
/ com!online 2005 May / com_0505_1.iso / opensource / top10 / amc_install.exe / {app} / Scripts / Alapage (Large Pic).ifs < prev    next >
Encoding:
Text File  |  2004-03-20  |  10.3 KB  |  297 lines
  1. // GETINFO SCRIPTING
  2. // Alapage (FR) Descriptif et image
  3.  
  4. (***************************************************
  5.  *  Script d'importation pour :                    *
  6.  *  ALAPAGE FRANCE , http://www.alapage.com        *
  7.  *                                                 *
  8.  *  (c) 2003   Thierry Colier                      *
  9.  *                                                 *
  10.  *  A utiliser avec Ant Movie Catalog 3.4.0        *
  11.  *  www.antp.be/software/moviecatalog              *
  12.  *                                                 *
  13.  *  This program is free software; you can         *
  14.  *  redistribute it and/or modify it under the     *
  15.  *  terms of the GNU General Public License as     *
  16.  *  published by the Free Software Foundation;     *
  17.  *  either version 2 of the License, or (at your   *
  18.  *  option) any later version.                     *
  19.  ***************************************************)
  20.  
  21. program ALAPAGE_FR;
  22. var
  23.   MovieName: string;
  24.  
  25. function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer;
  26. var
  27.   i: Integer;
  28. begin
  29.   result := -1;
  30.   if StartAt < 0 then
  31.     StartAt := 0;
  32.   for i := StartAt to List.Count-1 do
  33.     if Pos(Pattern, List.GetString(i)) <> 0 then
  34.     begin
  35.       result := i;
  36.       Break;
  37.     end;
  38. end;
  39.  
  40. procedure AnalyzeMoviePage(Page: TStringList);
  41. var
  42.   Line, Value, value2, nomImg: string;
  43.   LineNr: Integer;
  44.   BeginPos, EndPos, BeginVal2: Integer;
  45.   OnContinue : Boolean;
  46. begin
  47.    // Titre
  48.    LineNr := FindLine('<TD width="100%" class="tx14dvdbold">', Page, 0);
  49.    if LineNr > -1 then
  50.    begin
  51.       Value := Page.GetString(LineNr + 1);
  52.       value := trim(StringReplace (Value, #9, #32)); // pour remplacer les tabulations du debut par des espaces
  53.       HTMLRemoveTags(Value);
  54.       Value := AnsiUpFirstLetter(AnsiLowerCase(Value));
  55.       SetField(fieldTranslatedTitle, Value);
  56.    end;
  57.     
  58.    // Acteurs
  59.    LineNr := FindLine('<B>avec : </B>"<U><A', Page, 0);
  60.    if LineNr > -1 then
  61.    begin
  62.       Line := Page.GetString(LineNr);
  63.       Value := '';    
  64.       repeat
  65.          BeginPos := pos('X_LF_1" class="roll">', Line);
  66.          if (BeginPos > 0) then
  67.          begin
  68.             Delete(Line, 1, BeginPos+20);
  69.             EndPos := pos('</A></U>"', Line);
  70.             Value := Value + Copy(Line, 1, EndPos-1) + ' - ';
  71.          end;
  72.       until ( BeginPos = 0);
  73.       SetField(fieldActors, Value);
  74.    end;
  75.     
  76.    // Image
  77.    LineNr := FindLine('href="javascript:{agrandir(', Page, 0);
  78.    if LineNr > -1 then
  79.    begin
  80.       Line := Page.GetString(LineNr);
  81.       BeginVal2 := pos ('agrandir(', Line);
  82.       Delete(Line, 1, BeginVal2+9);
  83.       BeginVal2 := pos (',', Line);
  84.       value2 := copy (Line, 1, BeginVal2-2);
  85.       Line := Page.GetString(LineNr+1);
  86.  
  87.       BeginPos := pos('src="', Line) + 4;
  88.       Delete(Line, 1, BeginPos);
  89.       EndPos := pos('ref=v', Line);
  90.       Value := copy(Line, 1, EndPos + 4);
  91.       nomImg := 'http://www.alapage.com'+Value+Value2+'r.jpg';
  92. //      nomImgVerso := 'http://www.alapage.com'+Value+Value2+'v.jpg';
  93.       GetPicture(nomImg, False); // False = stocke l'image dans la base
  94.    end;
  95.  
  96.    // RΘalisateur
  97.    LineNr := FindLine('">Réalisateur :  </TD>', Page, 0);
  98.    if LineNr > -1 then
  99.    begin
  100.       Line := Page.GetString(LineNr+1);
  101.       BeginPos := pos('"roll"><SPAN class="tx12noir">', Line);
  102.       EndPos := pos('</SPAN></A>', Line);
  103.       Value := Copy(Line, BeginPos+30, EndPos - BeginPos-30);
  104.       SetField(fieldDirector, Value);
  105.    end;
  106.  
  107.    // Genre
  108.    LineNr := FindLine('">Genre :  </TD>', Page, 0);
  109.    if LineNr > -1 then
  110.    begin
  111.       Line := Page.GetString(LineNr+1);
  112.       BeginPos := pos('"roll"><SPAN class="tx12noir">', Line);
  113.       EndPos := pos('</SPAN></A>', Line);
  114.       Value := Copy(Line, BeginPos+30, EndPos - BeginPos-30);
  115.       SetField(fieldCategory, Value);
  116.    end;
  117.  
  118.    // Editeur
  119.    LineNr := FindLine('">Editeur :  </TD>', Page, 0);
  120.    if LineNr > -1 then
  121.    begin
  122.       Line := Page.GetString(LineNr+1);
  123.       BeginPos := pos('<SPAN class="tx12noir">', Line);
  124.       EndPos := pos('</SPAN></TD>', Line);
  125.       Value := Copy(Line, BeginPos+23, EndPos - BeginPos-23);
  126.       SetField(fieldProducer, Value);
  127.    end;
  128.  
  129.    // Zone
  130.    LineNr := FindLine('">Zone :  </TD>', Page, 0);
  131.    if LineNr > -1 then
  132.    begin
  133.       Line := Page.GetString(LineNr+1);
  134.       BeginPos := pos('<SPAN class="tx12noir">', Line);
  135.       EndPos := pos('</SPAN></TD>', Line);
  136.       Value := Copy(Line, BeginPos+23, EndPos - BeginPos-23);
  137.       SetField(fieldVideoFormat, 'DVD Zone '+Value);
  138.    end;
  139.  
  140.    // Description
  141.    LineNr := FindLine('class="tx14grisbold">Commentaires</TD>', Page, 0);
  142.    if LineNr > -1 then
  143.    begin
  144.       Value := StringReplace(Page.GetString(LineNr+12), '<br>', #13#10); ;
  145.       HTMLRemoveTags(Value);
  146.       HTMLDecode(Value);
  147.       value := StringReplace (Value, #9, #32); // pour remplacer les tabulations du debut par des espaces
  148.       SetField(fieldDescription, Trim(Value));
  149.    end;
  150.  
  151.    // Bonus
  152.    LineNr := FindLine('">Bonus / Interactivité</TD>', Page, 0);
  153.    if LineNr > -1 then
  154.    begin
  155.       Value := 'Bonus / InteractivitΘ :'+#13#10;
  156.       repeat
  157.            OnContinue := False;
  158.          repeat
  159.             LineNr := LineNr + 1;
  160.             Line := Page.GetString(LineNr);
  161.             BeginPos := pos('/puce_grise.gif" border="0" alt="">', Line);
  162.          until ( (BeginPos > 0) or (pos('<a name="donneravis">', Line)>0) );
  163.          if (BeginPos > 0) then
  164.          begin
  165.             OnContinue := True;
  166.             LineNr := LineNr + 1;
  167.             Line := Page.GetString(LineNr);
  168.             BeginPos := pos('"tx12noir" colspan="2">', Line);
  169.             EndPos := pos('<BR></TD>', Line);
  170.             Value := Value + Copy(Line, BeginPos+23, EndPos - BeginPos-23) + #13#10;
  171.          end;
  172.       until ( OnContinue = False);
  173.       HTMLRemoveTags(Value);
  174.       HTMLDecode(Value);
  175.       SetField(fieldComments, Value);
  176.    end;
  177.  
  178.    DisplayResults;
  179. end;
  180.  
  181. procedure AddMoviesTitles(Page: TStringList; var LineNr: Integer);
  182. var
  183.   Line: string;
  184.   MovieTitle, MovieAddress: string;
  185.   StartPos: Integer;
  186.   EndPos: Integer;
  187.   LastLine: Integer;
  188.  
  189. begin
  190.   repeat
  191.     LineNr := LineNr + 1;
  192.     Line := Page.GetString(LineNr);
  193.     LastLine := Page.count;
  194.     StartPos := pos('&VID_NUMERO=', Line);
  195.     if ((Startpos>0) and (pos('> Disponible en <b>occasion</b>', Line) > 0 )) then StartPos := 0; // pour ne pas prendre les lignes d'occasions
  196.     if StartPos > 0 then 
  197.     begin
  198.          LineNr := LineNr + 3;
  199.          Line := Page.GetString(LineNr);
  200.          StartPos := pos('href="/mx/?id=', Line);
  201.          Delete(Line, 1, StartPos);
  202.          MovieAddress := copy(Line, 6, pos('class="tx12noirbold"><u>', Line)-8 );
  203.          Delete(Line, 1, pos('><u>', Line)+3);
  204.          EndPos := pos('</u></A>', Line);
  205.          MovieTitle := copy(Line, 1, EndPos-1);
  206.          HTMLDecode(Movietitle);
  207.          PickTreeAdd(MovieTitle, 'http://www.alapage.com' + MovieAddress);
  208.     end;
  209.   until ((pos('Recherche rapide ', Line) > 0) or (pos('Page suivante »</DIV>', Line) > 0) or (pos('« Page précédente</a>', Line) > 0)) ;
  210.   if (pos('« Page précédente</a>', Line) > 0) then
  211.   begin
  212.      StartPos := pos('<a href="', Line);
  213.      EndPos :=     pos('" class="roll">« Page', Line);
  214.      PickTreeAdd('... << RΘsultats prΘcΘdents', 'http://www.alapage.com' + copy (Line, StartPos+9, Endpos-StartPos-9));
  215.   end;
  216.   if (pos('Page suivante »</DIV>', Line) > 0) then
  217.   begin
  218.      StartPos := pos('|  <A href="', Line);
  219.      EndPos :=     pos('" class="roll">Page suivante ', Line);
  220.      PickTreeAdd('RΘsultats suivants >> ...', 'http://www.alapage.com' + copy (Line, StartPos+22, Endpos-StartPos-22));
  221.   end;
  222. end;
  223.  
  224. procedure AnalyzePage(Address: string);
  225. var
  226.   Page: TStringList;
  227.   LineNr: Integer;
  228.   Line : String;
  229.   StartPos, EndPos : integer;
  230.   Adr : String;
  231. begin
  232.   Page := TStringList.Create;
  233.   Page.Text := GetPage(Address);
  234.  
  235.   if pos('> Caractéristiques</TD>', Page.Text) > 0 then 
  236.   begin
  237.     SetField(fieldURL, Address);
  238.     AnalyzeMoviePage(Page)
  239.   end
  240.   else
  241.      begin
  242.      if pos('>1 réponse</SPAN> pour', Page.Text) > 0 then // 1 rΘponse, on ouvre directement la page
  243.      begin
  244.        LineNr := 0;
  245.        LineNr := FindLine('&VID_NUMERO=', Page, LineNr);
  246.        Line := Page.GetString(LineNr+3);
  247.        StartPos := pos('href="/mx/?id=', Line);
  248.        Delete(Line, 1, StartPos);
  249.        Adr := 'http://www.alapage.com' + copy(Line, 6, pos('class="tx12noirbold"><u>', Line)-8 );
  250.        SetField(fieldURL, Adr);
  251.        Page.Text := GetPage(Adr);
  252.        AnalyzeMoviePage(Page)
  253.      end 
  254.      else 
  255.      begin
  256.          if pos('pas trouvé de réponses', Page.Text) > 0 then // aucune rΘponse
  257.          begin
  258.               ShowMessage('Aucun Film TrouvΘ pour : ' + MovieName);
  259.          end 
  260.          else
  261.          begin
  262.               PickTreeClear;
  263.               LineNr := 0;
  264.               LineNr := FindLine('réponses</SPAN> pour "', Page, LineNr); // trouvΘ plusieurs rΘponse
  265.               if LineNr > -1 then
  266.               begin
  267.                    Line := Page.GetString(LineNr);
  268.                    StartPos := pos ('<SPAN class="tx14orangefoncebold">', Line);
  269.                    EndPos := pos('réponses</SPAN>', Line);
  270.                    PickTreeAdd(copy (Line, StartPos+34, EndPos-StartPos-35)+' Films TrouvΘs pour ' + MovieName + ' :', '');
  271.                    AddMoviesTitles(Page, LineNr);
  272.               end;
  273.               if PickTreeExec(Address) then
  274.                  AnalyzePage(Address);
  275.          end;
  276.      end;
  277.   end;
  278.   Page.Free;
  279.  
  280. end;
  281.  
  282. begin
  283.   if CheckVersion(3,4,0) then
  284.   begin
  285.     MovieName := GetField(fieldTranslatedTitle);
  286.     if MovieName = '' then
  287.       MovieName := GetField(fieldOriginalTitle);
  288.  
  289.     if Input('Alapage.com Import', 'Entrer le titre du film :', MovieName) then
  290.     begin
  291.        AnalyzePage('http://www.alapage.com/mx/?tp=L&type=4&id=75071065095581&donnee_appel=BIGBO&suv_type=1&dispo=0&sort=titre&mot_vid_titre='+UrlEncode(MovieName));
  292.     end;
  293.   end 
  294.   else
  295.       ShowMessage('Ce script requiert une version plus rΘcente de Ant Movie Catalog (au moins la version 3.4.0)');
  296. end.
  297.